<--- %%NOBANNER%% --> _rantbl.sas
 BackForward

/*-------------------<-- Start of Description -->--------------------\
| Generate random variate from a tabled probability distribution;    |
| The function was writen by Duo Zhou;                               |
|--------------------<--- End of Description -->---------------------|
|--------------------------------------------------------------------|
|--------------<--- Start of Files or Arguments Needed -->-----------|
| Arguments Need:                                                    |
|      seed - seed; Required, default is the current system time;    |
|      var  - the variable to save the generated random variates;    |
|      p    - the proportion array;                                  |
|      n    - the dimension of the proportion array;                 |
|      lower- the lower bound;                                       |
|      array- a temporary array for internal use or output purpose;  |
|      init - this function is being used the 1st time in the current|
|             data step or not? default is 1: declare an array for   |
|             use; otherwise: do not declare the array, since it was |
|             alreay declared earlier;                               |
|      temp0- the seed value saver;                                  |
|      temp1- a variable for internal use only;                      |
|---------------<--- End of Files or Arguments Needed -->------------|
|--------------------------------------------------------------------|
|----------------<--- Start of Example and Usage -->-----------------|
| Example                                                            |
|   data one;                                                        |
|      array _p(3) (0.25, 0.5, 0.25);                                |
|      %_rantbl(seed=1, var=x, n=3, p=_p);                           |
|      put x _rantbl_(1) _rantbl_(2) _rantbl0_;                      |
|      do i=1 to 100000;                                             |
|         %_rantbl(seed=_rantbl0_, var=x, n=3, p=_p, init=0);        |
|         output;                                                    |
|      end;                                                          |
|   run;%print(one(obs=200));                                        |
| Usage: _rantbl(seed=%sysfunc(datetime(), 15.), var=REQUIRED,       |
|                 n=REQUIRED, p=, lower=, array=_rantbl_, init=1,    |
|                 temp0=_rantbl0_, temp1=_rantbl1_);                 |
\-------------------<--- End of Example and Usage -->---------------*/
%macro _rantbl(seed=%sysfunc(datetime(), 15.), var=REQUIRED, p=,  
               n=REQUIRED,lower=, array=_rantbl_, temp0=_rantbl0_, 
               temp1=_rantbl1_, init=1);
/*--------------------------------------------\
| Author:  Duo Zhou;                          |
| Created: 3-22-2002 6:30pm;                  |
| Purpose: Generate random variates from a    |
|          tabled probability distribution;   |
\--------------------------------------------*/
%let _nchk_=%sysfunc(rxmatch(%sysfunc(rxparse(.|$a|$A|$w)),&n));
%if (%quote(&seed) eq) or &_nchk_ or (%quote(&var) eq) %then %do;
   %if (%quote(&seed) eq) %then %do;
      %put ==> Error: This is not a valid seed!; 
      &var=.;
   %end;
   %if &_nchk_ %then %do;
      %put ==> Error: &n is not a valid array size!; 
      &var=.; 
   %end;
   %if (%quote(&var) eq) %then %do;
      %put ==> Error: I need a valid variable name!; 
   %end;
   %goto finish;
%end;
%else %if (&n le 1) %then %do;
      %put ==> Error: array size must be an integer large than 1!; 
      %if (%length(&var)) %then %do; &var=.; %end;
%end;
%else %do; 
   %if (not %sysfunc(rxmatch(%sysfunc(rxparse(_|.|$a|$A|$w)),&seed))) %then %do;
      drop &temp0;
      retain &temp0 &seed;
      %let seed=&temp0;
   %end;
   %if &init %then %do; 
      drop &temp1;
      array &array(%eval(&n-1)) _temporary_;
      %if (%length(&p)) %then %do;
         &array(1)=&p(1);
         do &temp1=2 to %eval(&n-1); 
            &array(&temp1)=&p(&temp1)+&array(&temp1-1);
         end;
      %end;
      %else %do;
         do &temp1=1 to &n-1;
            &array(&temp1)=&temp1/&n;
         end;
      %end;
   %end;
   call ranuni(&seed, &var);
   do &temp1=1 to &n-1 until(&var>1);
      if &var<=&array(&temp1) then &var=&temp1;
   end;
   if &var<1 then &var=&n;
   %if (%length(&lower)) %then &var=&var+&lower-1;
%end;
%finish:
%mend _rantbl;